Paso 3- Trayectorias de hospitalización y mortalidad con foco en condiciones vinculadas a trastornos de salud mental y consumo de sustancias posterior a un primer ingreso por alguno de estos trastornos, en usuarios/as jóvenes y adultos emergentes de población general y pertenecientes a pueblos originarios, 2018-2021, Chile (actualización)

Distintas secuencias: Trimestral y Mensual, con y sin censura; Seleccionar algoritmos para generar las matrices de agrupación, ver opciones de algoritmos de agrupamiento (jerárquico o por medoids); ver un rango de opciones de distinta cantidad de conglomerados.

Autor/a

Andrés González Santa Cruz

Fecha de publicación

22 de mar, 2025

Configurar

Código
# remover objetos y memoria utilizada
rm(list=ls());gc()
          used (Mb) gc trigger (Mb) max used (Mb)
Ncells  601414 32.2    1286608 68.8  1085684 58.0
Vcells 1152823  8.8    8388608 64.0  1942469 14.9
Código
if(Sys.info()["sysname"]=="Windows"){
 folder_path <- ifelse(dir.exists("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/"),
                       "H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/",
                       "C:/Users/CISS Fondecyt/Mi unidad/Alvacast/SISTRAT 2022 (github)/_proposal_grant/2023/")
} else {folder_path <- getwd()}
load(paste0(folder_path,"20240902_25.RData"))

Paquetes estadísticos

Código
#elegir repositorio
if(Sys.info()["sysname"]=="Windows"){
  options(repos = c(CRAN = "https://cran.dcc.uchile.cl/"))
}
options(install.packages.check.source = "yes") # Chequea la fuente de los paquetes

#borrar caché
#system("fc-cache -f -v")

if(!require(pacman)){install.packages("pacman");require(pacman)}

pacman::p_unlock(lib.loc = .libPaths()) #para no tener problemas reinstalando paquetes

if(Sys.info()["sysname"]=="Windows"){
if (getRversion() != "4.4.1") { stop("Requiere versión de R 4.4.1. Actual: ", getRversion()) }
}

if(!require(kableExtra)){install.packages("kableExtra");require(kableExtra)}
if(!require(tidyverse)){install.packages("tidyverse");require(tidyverse)}
if(!require(cluster)){install.packages("cluster"); require(cluster)}
if(!require(WeightedCluster)){install.packages("WeightedCluster"); require(WeightedCluster)}
if(!require(devtools)){install.packages("devtools"); require(devtools)}
if(!require(TraMineR)){install.packages("TraMineR"); require(TraMineR)}
if(!require(TraMineRextras)){install.packages("TraMineRextras"); require(TraMineRextras)}
if(!require(NbClust)){install.packages("NbClust"); require(NbClust)}
if(!require(haven)){install.packages("haven"); require(haven)}
if(!require(ggseqplot)){install.packages("ggseqplot"); require(ggseqplot)}
if(!require(gridExtra)){install.packages("gridExtra"); require(gridExtra)}
if(!require(Tmisc)){install.packages("Tmisc"); require(Tmisc)}
if(!require(factoextra)){install.packages("factoextra"); require(factoextra)}
#remotes::install_version("htmltools", "0.5.2")

#pacman job kableExtra tidyverse cluster WeightedCluster devtools TraMineR TraMineRextras NbClust haven ggseqplot gridExtra Tmisc factoextra reticulate  withr rmarkdown quarto

options(knitr.kable.NA = '')


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

knitr::knit_hooks$set(time_it = local({
  now <- NULL
  function(before, options) {
    if (before) {
      # record the current time before each chunk
      now <<- Sys.time()
    } else {
      # calculate the time difference after a chunk
      res <- ifelse(difftime(Sys.time(), now)>(60^2),difftime(Sys.time(), now)/(60^2),difftime(Sys.time(), now)/(60^1))
      # return a character string to show the time
      x<-ifelse(difftime(Sys.time(), now)>(60^2),paste("Tiempo que demora esta sección:", round(res,1), "horas"),paste("Tiempo que demora esta sección:", round(res,1), "minutos"))
      paste('<div class="message">', gsub('##', '\n', x),'</div>', sep = '\n')
    }
  }
}))
knitr::opts_chunk$set(time_it = TRUE)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

format_cells <- function(df, rows ,cols, value = c("italics", "bold", "strikethrough")){
  
  # select the correct markup
  # one * for italics, two ** for bold
  map <- setNames(c("*", "**", "~~"), c("italics", "bold", "strikethrough"))
  markup <- map[value]  
  
  for (r in rows){
    for(c in cols){
      
      # Make sure values are not factors
      df[[c]] <- as.character( df[[c]])
      
      # Update formatting
      df[r, c] <- ifelse(nchar(df[r, c])==0,"",paste0(markup, gsub(" ", "", df[r, c]), markup))
    }
  }
  
  return(df)
}
#To produce line breaks in messages and warnings
knitr::knit_hooks$set(
  error = function(x, options) {
    paste('\n\n<div class="alert alert-danger">',
          gsub('##', '\n', gsub('^##\ Error', '**Error**', x)),
          '</div>', sep = '\n')
  },
  warning = function(x, options) {
    paste('\n\n<div class="alert alert-warning">',
          gsub('##', '\n', gsub('^##\ Warning:', '**Warning**', x)),
          '</div>', sep = '\n')
  },
  message = function(x, options) {
    paste('<div class="message">',
          gsub('##', '\n', x),
          '</div>', sep = '\n')
  }
)

#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Function to format CreateTableOne into a database")

as.data.frame.TableOne <- function(x, ...) {capture.output(print(x,
                                                                 showAllLevels = TRUE, varLabels = T,...) -> x)
  y <- as.data.frame(x)
  y$characteristic <- dplyr::na_if(rownames(x), "")
  y <- y |>
    fill(characteristic, .direction = "down") |>
    dplyr::select(characteristic, everything())
  rownames(y) <- NULL
  y}
#_#_#_#_#_#_#_#_#_#_#_#_#_
# Austin, P. C. (2009). The Relative Ability of Different Propensity 
# Score Methods to Balance Measured Covariates Between 
# Treated and Untreated Subjects in Observational Studies. Medical 
# Decision Making. https://doi.org/10.1177/0272989X09341755
smd_bin <- function(x,y){
  z <- x*(1-x)
  t <- y*(1-y)
  k <- sum(z,t)
  l <- k/2
  
  return((x-y)/sqrt(l))
  
}


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:


#duración en cada estado
seq_mean_t<- function(bd=NULL, group= group){
  resultados<- by(bd, group, seqmeant)
  
  do.call(rbind, lapply(names(resultados), function(name) {
    data.frame(factor_inclusivo = name, resultados[[name]])
  }))
}


seqtrate_t<- function(bd=NULL, group= group){
    # Utilizar la función 'by' para calcular las tasas agrupadas por 'glosa_sexo'
    resultados <- by(bd, 
                     group, 
                     seqtrate)
    
    # Convertir los resultados en un data frame en formato largo
    resultados_long <- do.call(rbind, lapply(names(resultados), function(sexo) {
      df <- as.data.frame(resultados[[sexo]])
      df$from <- rownames(df)
      df$glosa_sexo <- sexo
      df
    }))
    
    # Usar tidyr para convertir a formato largo
    library(tidyr)
    resultados_long <- pivot_longer(resultados_long, 
                                    cols = -c(from, glosa_sexo), 
                                    names_to = "to", 
                                    values_to = "rate")
    
    # Mostrar el data frame final
    print(resultados_long)
}


seqcount_t<- function(bd=NULL, group= group){
    # Utilizar la función 'by' para calcular las tasas agrupadas por 'glosa_sexo'
  resultados <- by(bd, 
                   group, 
                   function(x) seqtrate(x, count = TRUE))
    
    # Convertir los resultados en un data frame en formato largo
    resultados_long <- do.call(rbind, lapply(names(resultados), function(sexo) {
      df <- as.data.frame(resultados[[sexo]])
      df$from <- rownames(df)
      df$glosa_sexo <- sexo
      df
    }))
    
    # Usar tidyr para convertir a formato largo
    library(tidyr)
    resultados_long <- pivot_longer(resultados_long, 
                                    cols = -c(from, glosa_sexo), 
                                    names_to = "to", 
                                    values_to = "count")
    
    # Mostrar el data frame final
    print(resultados_long)
}
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:


if(.Platform$OS.type == "windows") withAutoprint({
  memory.size()
  memory.size(TRUE)
  memory.limit()
})
> memory.size()
[1] Inf
> memory.size(TRUE)
[1] Inf
> memory.limit()
[1] Inf
Código
if(Sys.info()["sysname"]=="Windows"){memory.limit(size=56000)}
[1] Inf

Agregamos un estado de mortalidad para distinguirlo de otros tipos de censura. Por mientras, lo dejaré en otra base.

Código
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens_d <- ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens_d <- ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens

for(i in 59:1) {
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens_d <- ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens_d |>
    dplyr::mutate(!!as.character(i) := ifelse(ceiling(death_time) <= i, "cens", !!sym(as.character(i))))
}
for(i in 19:1) {
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens_d <- ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens_d |>
    dplyr::mutate(!!as.character(i) := ifelse(ceiling(death_time) <= i, "cens", !!sym(as.character(i))))
}

invisible("Se eliminan 2 casos que no tienen otra cosa que ausente")
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2 |> 
  dplyr::filter(`0`!="aus")

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens |> 
  dplyr::filter(`0`!="aus")

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4 |> 
  dplyr::filter(`0`!="aus")  

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4_cens<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4_cens |> 
  dplyr::filter(`0`!="aus")  


ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2<-
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2 |> 
  dplyr::filter(`0`!="aus")

ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens<-
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens |> 
  dplyr::filter(`0`!="aus")

ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4<-
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4 |> 
  dplyr::filter(`0`!="aus")  


ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens<-
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens |> 
  dplyr::filter(`0`!="aus")  

invisible("Para mantener la base de datos anterior")
casos_prob<- c("ef1193767a2df73d6fdb1dd59d35edce262a9031d9ca5b012a11d088081b746e", 
     "bd0c2f8dcc5209831487342eda88d0b0461c98150911e36b64b4055a846a3631")
invisible("de 6,626 se reduce en 6.626 ya que ya habían sido descartado. Responden a la base 2024")

Tiempo que demora esta sección: 0.1 minutos

0. Generar un análisis de secuencias

Primero creamos un alfabeto de estados discretos (secuencias). Luego, generamos las secuencias.

Código
#Pre-agosto
#    # state_alphabet <- c("coc", "mar", "oh", "psu", "cp",  
#    #                     "cp_psu","psy", "aus", "otro", "cens")  
#    # 
#    # # Create a vector that allows for more helpful labels if applicable 
#    # state_labels <- c("Cocaína", "Marihuana", "Alcohol", 
#    #                   "Policonsumo", "Comorbilidad", "Comorbilidad\ny policonsumo", 
#    #                   "Morbilidad\npsiquiátrica", "Ausente", "Otras causas","Censurado")

#2024-08-09: modificaron los estados del alfabeto
state_alphabet <- c("sus", "cp", "psi", "aus", "otro", "cens")  

# Create a vector that allows for more helpful labels if applicable 
state_labels <- c("Consumo\nde sustancias", "Comorbilidad", "Morbilidad\npsiquiátrica", "Ausente", "Otras causas","Censurado")

#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Generar las trayectorias: WHY")

States_Wide.seq_quarter_t_prim_adm <- seqdef(
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)):dim(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)[[2]],#61 para month                    # Columns containing the sequences
  alphabet = state_alphabet[-length(state_alphabet)],
  labels = state_labels[-length(state_labels)],
  start=0,  #Define el punto de inicio de la secuencia. Esto puede ser útil para visualizar mejor la secuencia.
  # left="aus", # Define el estado que se utilizará para la porción izquierda de la secuencia cuando hay datos faltantes al principio.
  #right="cens", # Define el estado que se utilizará para la porción derecha de la secuencia cuando hay datos faltantes al final.
  # gaps="aus", # Define el estado que se utilizará para representar las brechas (gaps) dentro de la secuencia.
  # missing="aus", 
  # void="aus", 
  xtstep = 4,  cpal=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                       "#FFFFFF","#808080"))#,"#000000")) 

States_Wide.seq_quarter_t_prim_adm_cens <- seqdef(
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)):dim(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)[[2]],#61 para month                    # Columns containing the sequences
  alphabet = state_alphabet,
  labels = state_labels,
  start=0,  
  right="cens",
  xtstep = 4,  cpal=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                       "#FFFFFF","#808080","#000000")) #"#000000", 

States_Wide.seq_month_t_prim_adm <- seqdef(
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2)):dim(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2)[[2]],
  alphabet = state_alphabet[-length(state_alphabet)],
  labels = state_labels[-length(state_labels)],
  start=0,
xtstep = 4,  cpal=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                       "#FFFFFF","#808080"))#,"#000000")) 

States_Wide.seq_month_t_prim_adm_cens <- seqdef(
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens)):dim(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens)[[2]],#2:61,#61 para month                    # Columns containing the sequences
  alphabet = state_alphabet,
  labels = state_labels,
  start=0, 
  right="cens", 
  xtstep = 4,  cpal=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                       "#FFFFFF","#808080","#000000")) #"#000000", 


#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Generar las trayectorias: WHERE")

#state_alphabetRM <- c("noRM", "RM", "aus", "otro", "cens")  
state_alphabetRM <- c("noRM", "RM", "aus", "cens")  

# Create a vector that allows for more helpful labels if applicable 
#state_labelsRM <- c("Otra\nregión", "Región\nMetropolitana","Ausente", "Otras causas","Censurado")
state_labelsRM <- c("Otra\nregión", "Región\nMetropolitana","Ausente", "Censurado")


States_Wide.seq_quarter_t_prim_adm_RM <- seqdef(
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4)):dim(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4)[[2]],#61 para month                    # Columns containing the sequences
  alphabet = state_alphabetRM[-length(state_alphabetRM)],
  labels = state_labelsRM[-length(state_labelsRM)],
  start=0,
  xtstep = 4,  cpal=c("#2A4B5F", "#F5E3A1",
                       "#FFFFFF"))#,"#808080","#000000")) 

States_Wide.seq_quarter_t_prim_adm_RM_cens <- seqdef(
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4_cens, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)):dim(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2)[[2]],#61 para month                    # Columns containing the sequences
  alphabet = state_alphabetRM,
  labels = state_labelsRM,
  start=0,  
  right="cens",
  xtstep = 4,  cpal=c("#2A4B5F", "#F5E3A1",
                       "#FFFFFF","#000000")) #"#808080",

States_Wide.seq_month_t_prim_adm_RM <- seqdef(
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4)):dim(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4)[[2]],
  alphabet = state_alphabetRM[-length(state_alphabetRM)],
  labels = state_labelsRM[-length(state_labelsRM)],
  start=0,
  xtstep = 4,  cpal=c("#2A4B5F", "#F5E3A1",
                       "#FFFFFF"))#,"#808080","#000000")) 

States_Wide.seq_month_t_prim_adm_RM_cens <- seqdef(
  ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens, #States_Wide, # Select data   
  var = match("0",names(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens)):dim(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4_cens)[[2]],#2:61,#61 para month                    # Columns containing the sequences
  alphabet = state_alphabetRM,
  labels = state_labelsRM,
  start=0, 
  right="cens", 
  xtstep = 4,  cpal=c("#2A4B5F", "#F5E3A1",
                       "#FFFFFF","#000000")) #"#808080",

Tiempo que demora esta sección: 0 minutos

0.a. Descriptivos

Visualizamos mediante Index plots (ordenados desde el inicio)

General

Código
gc()
seqIplot(States_Wide.seq_quarter_t_prim_adm, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias", # Plot title
         xlab = "Trimestres desde la primera admisión") 
             used    (Mb) gc trigger    (Mb)   max used    (Mb)
Ncells   12544363   670.0   23152607  1236.5   16853261   900.1
Vcells 3315557871 25295.7 5139839368 39213.9 3359719010 25632.7
Trayectorias

Trayectorias

Tiempo que demora esta sección: 0.1 minutos

Código
seqIplot(States_Wide.seq_quarter_t_prim_adm_cens, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias (con censura)", # Plot title
         xlab = "Trimestres desde la primera admisión") 
Trayectorias

Trayectorias

Tiempo que demora esta sección: 0.1 minutos

Código
seqIplot(States_Wide.seq_month_t_prim_adm, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias", # Plot title
         xlab = "Meses desde la primera admisión") 
Trayectorias

Trayectorias

Tiempo que demora esta sección: 0.2 minutos

Código
seqIplot(States_Wide.seq_month_t_prim_adm_cens, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias (con censura)", # Plot title
         xlab = "Meses desde la primera admisión") 
Trayectorias

Trayectorias

Tiempo que demora esta sección: 0.3 minutos

Código
seqIplot(States_Wide.seq_quarter_t_prim_adm_RM, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias", # Plot title
         xlab = "Trimestres desde la primera admisión") 
Trayectorias

Trayectorias

Tiempo que demora esta sección: 0.3 minutos

Código
seqIplot(States_Wide.seq_quarter_t_prim_adm_RM_cens, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias (con censura)", # Plot title
         xlab = "Trimestres desde la primera admisión") 
Trayectorias

Trayectorias

Tiempo que demora esta sección: 0.1 minutos

Código
seqIplot(States_Wide.seq_month_t_prim_adm_RM, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias", # Plot title
         xlab = "Meses desde la primera admisión") 
Trayectorias

Trayectorias

Tiempo que demora esta sección: 0.2 minutos

Código
seqIplot(States_Wide.seq_month_t_prim_adm_RM_cens, sortv = "from.start",   # Sequence object
         with.legend = "right", # Display legend on right side of plot
         cex.legend = 0.6,  # Change size of legend
         main = "Gráfico de índice de secuencias (con censura)", # Plot title
         xlab = "Meses desde la primera admisión") 

# recorded_plot <- recordPlot() 
# png("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/_figs/seqin_trim_inicio.png", height=6, width=8, res=500, units="in") 
# recorded_plot
# dev.off()
Trayectorias

Trayectorias

Tiempo que demora esta sección: 0.2 minutos

Vemos las secuencias más frecuentes

Código
seqtab(States_Wide.seq_quarter_t_prim_adm)->freqtab_trim
seqtab(States_Wide.seq_quarter_t_prim_adm_cens)->freqtab_trim_cens
seqtab(States_Wide.seq_month_t_prim_adm)->freqtab_mes
seqtab(States_Wide.seq_month_t_prim_adm_cens)->freqtab_mes_cens

rbind.data.frame(
cbind.data.frame(marco= "Trimestral (s/censura)", data.table::as.data.table(attr(freqtab_trim,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Trimestral (c/censura)", data.table::as.data.table(attr(freqtab_trim_cens,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Mensual (s/censura)", data.table::as.data.table(attr(freqtab_mes,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Mensual (c/censura)", data.table::as.data.table(attr(freqtab_mes_cens,"freq"), keep.rownames = "Secuencias (estado/frecuencia)"))
) |> 
  dplyr::mutate(Percent= scales::percent(Percent/100, accuracy=0.1)) |> 
  (\(df) {
    write.table(df, file = paste0(getwd(),"secuencias_mas_frecuentes_25.csv"), dec=",", sep="\t")
    knitr::kable(df, size=10, format="html", caption="Secuencias más frecuentes") |> 
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) |> 
    kableExtra::scroll_box(width = "100%", height = "375px")  
  })()
Secuencias más frecuentes
marco Secuencias (estado/frecuencia) Freq Percent
Trimestral (s/censura) psi/1-aus/19 3327 50.2%
Trimestral (s/censura) sus/1-aus/19 485 7.3%
Trimestral (s/censura) psi/2-aus/18 142 2.1%
Trimestral (s/censura) cp/1-aus/19 119 1.8%
Trimestral (s/censura) psi/1-otro/1-aus/18 91 1.4%
Trimestral (s/censura) psi/1-aus/2-otro/1-aus/16 80 1.2%
Trimestral (s/censura) psi/1-aus/3-otro/1-aus/15 78 1.2%
Trimestral (s/censura) psi/1-aus/1-otro/1-aus/17 72 1.1%
Trimestral (s/censura) psi/1-aus/6-otro/1-aus/12 64 1.0%
Trimestral (s/censura) psi/1-aus/5-otro/1-aus/13 63 1.0%
Trimestral (c/censura) psi/1-aus/18-cens/1 892 13.5%
Trimestral (c/censura) psi/1-aus/16-cens/3 890 13.4%
Trimestral (c/censura) psi/1-aus/17-cens/2 832 12.6%
Trimestral (c/censura) psi/1-aus/19 671 10.1%
Trimestral (c/censura) sus/1-aus/19 144 2.2%
Trimestral (c/censura) sus/1-aus/18-cens/1 113 1.7%
Trimestral (c/censura) sus/1-aus/17-cens/2 112 1.7%
Trimestral (c/censura) sus/1-aus/16-cens/3 102 1.5%
Trimestral (c/censura) psi/2-aus/17-cens/1 41 0.6%
Trimestral (c/censura) psi/2-aus/16-cens/2 39 0.6%
Mensual (s/censura) psi/1-aus/59 2786 42.0%
Mensual (s/censura) sus/1-aus/59 443 6.7%
Mensual (s/censura) psi/2-aus/58 369 5.6%
Mensual (s/censura) psi/3-aus/57 84 1.3%
Mensual (s/censura) cp/1-aus/59 81 1.2%
Mensual (s/censura) psi/1-otro/1-aus/58 35 0.5%
Mensual (s/censura) psi/1-aus/20-otro/1-aus/38 28 0.4%
Mensual (s/censura) sus/2-aus/58 28 0.4%
Mensual (s/censura) psi/1-aus/10-otro/1-aus/48 27 0.4%
Mensual (s/censura) psi/1-aus/13-otro/1-aus/45 24 0.4%
Mensual (c/censura) psi/1-aus/55-cens/4 269 4.1%
Mensual (c/censura) psi/1-aus/50-cens/9 267 4.0%
Mensual (c/censura) psi/1-aus/49-cens/10 258 3.9%
Mensual (c/censura) psi/1-aus/52-cens/7 256 3.9%
Mensual (c/censura) psi/1-aus/54-cens/5 250 3.8%
Mensual (c/censura) psi/1-aus/48-cens/11 244 3.7%
Mensual (c/censura) psi/1-aus/56-cens/3 229 3.5%
Mensual (c/censura) psi/1-aus/51-cens/8 219 3.3%
Mensual (c/censura) psi/1-aus/53-cens/6 219 3.3%
Mensual (c/censura) psi/1-aus/57-cens/2 202 3.0%

Tiempo que demora esta sección: 0.1 minutos

A partir de la tabla anterior, se confirma que más del 50% sólo tienen un evento hospitalario, liderando el por causas psiquiátricas (52%) seguido muy de lejos por un sólo ingreso por consumo de sustancias (8%) y comorbilidad (2%). Luego, un 2% tiene más de un evento psiquiátrico que habría durado más de un trimestre, presumiblemente, debido a su continuidad. Para la base con datos mensuales, un 44% corresponde a un mes en ingreso por causas psiquiátricas, un 7% por causas por consumo de sustancias y un 1% por comorbilidad. También se constata eventos compuestos de 2 meses en consulta psiquiátrica (6%) y hasta 3 (1%).

Código
seqtab(States_Wide.seq_quarter_t_prim_adm_RM)->freqtab_trim_reg
seqtab(States_Wide.seq_quarter_t_prim_adm_RM_cens)->freqtab_trim_cens_reg
seqtab(States_Wide.seq_month_t_prim_adm_RM)->freqtab_mes_reg
seqtab(States_Wide.seq_month_t_prim_adm_RM_cens)->freqtab_mes_cens_reg

rbind.data.frame(
cbind.data.frame(marco= "Trimestral (s/censura)", data.table::as.data.table(attr(freqtab_trim_reg,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Trimestral (c/censura)", data.table::as.data.table(attr(freqtab_trim_cens_reg,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Mensual (s/censura)", data.table::as.data.table(attr(freqtab_mes_reg,"freq"), keep.rownames = "Secuencias (estado/frecuencia)")),
cbind.data.frame(marco= "Mensual (c/censura)", data.table::as.data.table(attr(freqtab_mes_cens_reg,"freq"), keep.rownames = "Secuencias (estado/frecuencia)"))
) |> 
  dplyr::mutate(Percent= scales::percent(Percent/100, accuracy=0.1))|> 
  (\(df) {
    write.table(df, file = paste0(getwd(),"secuencias_mas_frecuentes_reg_25.csv"), dec=",", sep="\t")
    knitr::kable(df, size=10, format="html", caption="Secuencias más frecuentes (región)") |> 
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) |> 
    kableExtra::scroll_box(width = "100%", height = "375px")  
  })()
Secuencias más frecuentes (región)
marco Secuencias (estado/frecuencia) Freq Percent
Trimestral (s/censura) noRM/1-aus/19 2146 32.4%
Trimestral (s/censura) RM/1-aus/19 1785 26.9%
Trimestral (s/censura) noRM/2-aus/18 144 2.2%
Trimestral (s/censura) RM/2-aus/18 122 1.8%
Trimestral (s/censura) noRM/1-aus/2-noRM/1-aus/16 80 1.2%
Trimestral (s/censura) noRM/1-aus/1-noRM/1-aus/17 76 1.1%
Trimestral (s/censura) noRM/1-aus/5-noRM/1-aus/13 67 1.0%
Trimestral (s/censura) RM/1-aus/3-RM/1-aus/15 65 1.0%
Trimestral (s/censura) RM/1-aus/2-RM/1-aus/16 63 1.0%
Trimestral (s/censura) noRM/1-aus/3-noRM/1-aus/15 62 0.9%
Trimestral (c/censura) noRM/1-aus/18-cens/1 561 8.5%
Trimestral (c/censura) noRM/1-aus/17-cens/2 538 8.1%
Trimestral (c/censura) noRM/1-aus/16-cens/3 535 8.1%
Trimestral (c/censura) RM/1-aus/16-cens/3 484 7.3%
Trimestral (c/censura) noRM/1-aus/19 476 7.2%
Trimestral (c/censura) RM/1-aus/18-cens/1 467 7.0%
Trimestral (c/censura) RM/1-aus/17-cens/2 436 6.6%
Trimestral (c/censura) RM/1-aus/19 374 5.6%
Trimestral (c/censura) noRM/2-aus/17-cens/1 42 0.6%
Trimestral (c/censura) noRM/2-aus/15-cens/3 39 0.6%
Mensual (s/censura) noRM/1-aus/59 1847 27.9%
Mensual (s/censura) RM/1-aus/59 1463 22.1%
Mensual (s/censura) RM/2-aus/58 252 3.8%
Mensual (s/censura) noRM/2-aus/58 204 3.1%
Mensual (s/censura) noRM/3-aus/57 56 0.8%
Mensual (s/censura) RM/3-aus/57 52 0.8%
Mensual (s/censura) noRM/1-aus/1-noRM/1-aus/57 26 0.4%
Mensual (s/censura) noRM/1-aus/3-noRM/1-aus/55 25 0.4%
Mensual (s/censura) noRM/1-aus/10-noRM/1-aus/48 22 0.3%
Mensual (s/censura) noRM/1-aus/19-noRM/1-aus/39 21 0.3%
Mensual (c/censura) noRM/1-aus/55-cens/4 184 2.8%
Mensual (c/censura) noRM/1-aus/50-cens/9 163 2.5%
Mensual (c/censura) noRM/1-aus/52-cens/7 163 2.5%
Mensual (c/censura) noRM/1-aus/48-cens/11 160 2.4%
Mensual (c/censura) RM/1-aus/49-cens/10 158 2.4%
Mensual (c/censura) noRM/1-aus/54-cens/5 157 2.4%
Mensual (c/censura) noRM/1-aus/51-cens/8 151 2.3%
Mensual (c/censura) noRM/1-aus/49-cens/10 149 2.2%
Mensual (c/censura) noRM/1-aus/53-cens/6 149 2.2%
Mensual (c/censura) RM/1-aus/50-cens/9 145 2.2%

Tiempo que demora esta sección: 0 minutos

Para las secuencias regionales, se observa que una mayor parte de los ingresos corresponde a personas que no tienen su primer y único ingreso en la región metropolitana (34%), seguido por quienes sí lo tienen (28%). Posteriormente, se encuentran los que tienen un evento continuo presumiblemente fuera de la región metropolitana (2%) y en la región metropolitana (2%).

Luego, vimos un tiempo promedio en cada estado.

Entropía

La entropía transversal es una métrica de diversidad de estados observados en cada posición. Un valor de 0 significa que todos las observaciones están en un mismo estado y su valor es máximo cuando hay una misma proporción de casos que están en el mismo estado.

Código
plot(seqstatd(States_Wide.seq_quarter_t_prim_adm), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Trimestres", xtlab=1:21)
Entropía de Shannon por tiempo de seguimiento

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Código
plot(seqstatd(States_Wide.seq_quarter_t_prim_adm_cens), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Trimestres", xtlab=1:21)
Entropía de Shannon por tiempo de seguimiento

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Código
plot(seqstatd(States_Wide.seq_month_t_prim_adm), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Meses", xtlab=1:61)
Entropía de Shannon por tiempo de seguimiento

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Código
plot(seqstatd(States_Wide.seq_month_t_prim_adm_cens), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Meses", xtlab=1:61)
Entropía de Shannon por tiempo de seguimiento

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Código
plot(seqstatd(States_Wide.seq_quarter_t_prim_adm_RM), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Trimestre", xtlab=1:21)
Entropía de Shannon por tiempo de seguimiento

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Código
plot(seqstatd(States_Wide.seq_quarter_t_prim_adm_RM_cens), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Trimestre", xtlab=1:21)
Entropía de Shannon por tiempo de seguimiento

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Código
plot(seqstatd(States_Wide.seq_month_t_prim_adm_RM), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Meses", xtlab=1:61)
Entropía de Shannon por tiempo de seguimiento

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

Código
plot(seqstatd(States_Wide.seq_month_t_prim_adm_RM_cens), type="Ht", #main="Age-specific Shannon's Entropy", 
     xlab= "Meses", xtlab=1:61)
Entropía de Shannon por tiempo de seguimiento

Entropía de Shannon por tiempo de seguimiento

Tiempo que demora esta sección: 0 minutos

En general todos parecen estar en el estado ausente, salvo en los modelos que incorporan censura al final del estudio, en donde aparecen como censurados.

Tiempo promedio en cada estado

Código
invisible("2024-09-02, sacar cosas")
seq_mean_t(States_Wide.seq_quarter_t_prim_adm, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) |>
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Trimestral, s/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
        #axis.text.y = element_blank(),
        panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_quarter_t_prim_adm_RM, 
            subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4, !run %in% casos_prob, glosa_sexo)) |>
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Trimestral, s/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
        #axis.text.y = element_blank(),
        panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) |> 
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Trimestral, c/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())  
Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_quarter_t_prim_adm, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc))|> 
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Trimestral s/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) |> 
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Trimestral s/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) |> 
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Trimestral c/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
    geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo promedio en cada estado por distintas variables (trimestral)

Tiempo que demora esta sección: 0 minutos

Ahora por mes

Código
seq_mean_t(States_Wide.seq_month_t_prim_adm, 
           subset(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) |>
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Mensual, s/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
        #axis.text.y = element_blank(),
        panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_month_t_prim_adm_RM, 
           subset(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) |>
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Mensual, s/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
        #axis.text.y = element_blank(),
        panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_month_t_prim_adm_cens, 
           subset(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, glosa_sexo)) |> 
  data.table::as.data.table(keep.rowname=T) |> 
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  coord_flip()+
  labs(title = "Tiempo promedio en cada estado por sexo (Mensual, c/censura)",
       x = NULL,
       y = NULL) +
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1") +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())  
Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_month_t_prim_adm, 
           subset(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) |> 
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Mensual s/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_month_t_prim_adm_RM, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) |> 
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Mensual s/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

Código
seq_mean_t(States_Wide.seq_month_t_prim_adm_cens, 
           subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, factor_inclusivo_real_hist_mas_autperc)) |> 
  data.table::as.data.table(keep.rowname=T) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  labs(title = "Tiempo promedio en cada estado por estatus PPOO (Mensual c/censura)",
       x = NULL,
       y = NULL) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
    geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 2.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())
Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo promedio en cada estado por distintas variables (mensual)

Tiempo que demora esta sección: 0 minutos

No se aprecian diferencias sustanciales por categoría. Tal vez, las mujeres se encuentran más tiempo en ingresos psiquiátricos y por otras causas, pero es una diferencia muy leve. Quienes no están en la Región Metropolitana tienen más tiempo en promedio en ingreso hospitalario para el caso de quienes tienen reconocimiento CONADI y se autoidentifican además de los que sólo tienen autoidentificación vs. las personas en la región metropolitana.

0.b. Tasas de transición

La probabilidad de cambiar en un posición de un estado a otro. Por defecto, las probabilidades se asumieron independientes de la posición, esto es, el mismo sin importar el punto de tiempo.

Trimestre

Código
trim_tasa_sexo_cnt<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm, 
           group=subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_sexo_rate<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm, 
           group=subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  

trim_tasa_sexo_rate |>   
dplyr::left_join(trim_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (trimestral)

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
trim_tasa_sexo_cnt_rm<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           group= subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_sexo_rate_rm<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           group= subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide, !run %in% casos_prob, glosa_sexo)) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  

trim_tasa_sexo_rate_rm |>   
dplyr::left_join(trim_tasa_sexo_cnt_rm, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura)- RM",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (trimestral)

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
trim_tasa_sexo_cnt_cens<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           group= subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, glosa_sexo)) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_sexo_rate_cens<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           group= subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide_cens, !run %in% casos_prob, glosa_sexo)) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



trim_tasa_sexo_rate_cens |>   
dplyr::left_join(trim_tasa_sexo_cnt_cens, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (c/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (trimestral)

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
trim_tasa_ppoo_cnt<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_ppoo_rate<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



trim_tasa_ppoo_rate |>   
dplyr::left_join(trim_tasa_ppoo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (trimestral)

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
trim_tasa_ppoo_cnt_rm<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_ppoo_rate_rm<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm_RM, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide4$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



trim_tasa_ppoo_rate_rm |>   
dplyr::left_join(trim_tasa_ppoo_cnt_rm, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura) (RM)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (trimestral)

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Código
trim_tasa_ppoo_cnt_cens<-  
seqcount_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

trim_tasa_ppoo_rate_cens<-  
seqtrate_t(States_Wide.seq_quarter_t_prim_adm_cens, 
           group=factor(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



trim_tasa_ppoo_rate_cens |>   
dplyr::left_join(trim_tasa_ppoo_cnt_cens, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (c/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (trimestral)

Tasas de transición (trimestral)

Tiempo que demora esta sección: 0 minutos

Para ver los números detrás de las transiciones, calcular exp(x-1).

  • De los ingresos por otras causas, más hombres transitan a un nuevo ingreso por otras causas (16%, n=94 vs. 12%, n=148), más hombres se mantienen transitando desde comorbilidad a ingresos presentando comorbilidad nuevamente (14%, n=34 vs. 11%, n=12), pero más mujeres que ingresaron por sustancias reingresan al sistema de salud por algún motivo (16%, n=42 vs. 10%, n=54).
  • Aunque son pocos casos, personas con autoidentificación y reconocimiento (~30) que ingresaron por comorbilidad registran más transiciones a comorbilidad (14%, n=4) o ingreso con diagnóstico psiquiátrico (14%, n=4) vs. el resto.
  • Asimismo, personas con autoidentificación y reconocimiento y autoidentificación sin reconocimiento que ingresan por consumo de sustancias tienen más ingresos relativos (8%, n=7; 10% n=10) que sin autoidentificación ni reconocimiento (5% n=33).
Código
trim_tasa_sexo_rate |> 
    dplyr::left_join(trim_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to"))|> 
    dplyr::rename("recuento"="count") |> 
    dplyr::filter(from=="sus") |> 
    dplyr::mutate(gr=ifelse(to=="aus",1,0)) |> 
    dplyr::group_by(glosa_sexo,gr) |> 
        summarise(rate=sum(rate),recuento=sum(recuento))

trim_tasa_ppoo_rate |>   
  dplyr::left_join(trim_tasa_ppoo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to"))|>
  dplyr::rename("recuento"="count") |> 
  dplyr::filter(from=="cp")

Tiempo que demora esta sección: 0 minutos

Mensual

Código
mes_tasa_sexo_cnt<-  
seqcount_t(States_Wide.seq_month_t_prim_adm, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_sexo_rate<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  

mes_tasa_sexo_rate |>   
dplyr::left_join(mes_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (mensual)

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Código
mes_tasa_sexo_cnt_rm<-  
seqcount_t(States_Wide.seq_month_t_prim_adm_RM, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_sexo_rate_rm<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm_RM, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  

mes_tasa_sexo_rate_rm |>   
dplyr::left_join(mes_tasa_sexo_cnt_rm, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (s/censura) (RM)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (mensual)

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Código
mes_tasa_sexo_cnt_cens<-  
seqcount_t(States_Wide.seq_month_t_prim_adm_cens, 
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_sexo_rate_cens<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm_cens,
           group=ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$glosa_sexo) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



mes_tasa_sexo_rate_cens |>   
dplyr::left_join(mes_tasa_sexo_cnt_cens, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (c/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (mensual)

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Código
mes_tasa_ppoo_cnt<-  
seqcount_t(States_Wide.seq_month_t_prim_adm, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_ppoo_rate<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



mes_tasa_ppoo_rate |>   
dplyr::left_join(mes_tasa_ppoo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (mensual)

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Código
mes_tasa_ppoo_cnt_rm<-  
seqcount_t(States_Wide.seq_month_t_prim_adm_RM, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_ppoo_rate_rm<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm_RM, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide4$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



mes_tasa_ppoo_rate_rm |>   
dplyr::left_join(mes_tasa_ppoo_cnt_rm, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (mensual)

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Código
mes_tasa_ppoo_cnt_cens<-  
seqcount_t(States_Wide.seq_month_t_prim_adm_cens, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(count>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 

mes_tasa_ppoo_rate_cens<-  
seqtrate_t(States_Wide.seq_month_t_prim_adm_cens, 
           group=factor(ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc, labels= c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas"))) |> 
  dplyr::filter(rate>0) |> 
  dplyr::mutate(trans = paste0(from,"_", to)) |> 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))  



mes_tasa_ppoo_rate_cens |>   
dplyr::left_join(mes_tasa_ppoo_cnt_cens, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Mensual (c/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Tasas de transición (mensual)

Tasas de transición (mensual)

Tiempo que demora esta sección: 0 minutos

Para ver los números detrás de las transiciones, calcular exp(x-1).

  • Más mujeres que ingresaron por sustancias reingresan al sistema de salud por dicho motivo (23%, n=73 vs. 12%, n=74).
  • Más hombres que ingresan con diagnósticos psiquiátricos transitan a un ingreso con un diagnóstico del mismo tipo (35%, n=1517 vs. 26%, n=1404). Asimismo, más hombres que ingresan por otros motivos también registran un ingreso posterior por otros motivos (25%, n=188 vs. 19%, n=303). Por último, hombres que ingresan por comorbilidad experimentan una transición a comorbilidad con mayor frecuencia (43%, n=148 vs. 29%, n=38).
  • Entre quienes ingresan por sustancias, quienes se autoidentifican y son reconocidos como pertenecientes a PPOO presentan menos transiciones al mismo estado (13%, n=13) vs. quienes se autoidentifican pero no son reconocidos (18% n=21) o que no se autoidentifican ni son reconocidos (15% n=113).
  • Quienes se autoidentifican pero no poseen reconocimiento de la CONADI y fueron ingresados con diagnóstico de comorbilidad, registran menos transiciones a un ingreso con comorbilidad (24%, n=8) que el resto (40%, n_ambas=17, n_ninguna= 161)
  • Mujeres tienen menos transiciones (~25% vs. ~33%) que hombres cuando vemos las transiciones de región.

En resumen: - Se hace difícil distinguir entre PPOO por grados hasta el momento. Dejarlo para una reflexión posterior, para el análisis una vez teniendo los conglomerados.

Código
trim_tasa_sexo_rate |> 
    dplyr::left_join(trim_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to"))|> 
    dplyr::rename("recuento"="count") |> 
    dplyr::filter(from=="sus") |> 
    dplyr::mutate(gr=ifelse(to=="aus",1,0)) |> 
    dplyr::group_by(glosa_sexo,gr) |> 
        summarise(rate=sum(rate),recuento=sum(recuento))

trim_tasa_ppoo_rate |>   
  dplyr::left_join(trim_tasa_ppoo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to"))|>
  dplyr::rename("recuento"="count") |> 
  dplyr::filter(from=="cp")
#mes_tasa_ppoo_rate_cens  
#mes_tasa_sexo_cnt_rm
#
#
mes_tasa_sexo_rate |>   
dplyr::left_join(mes_tasa_sexo_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) |> 
  dplyr::rename("recuento"="count") |> 
  dplyr::filter(from=="sus")

Tiempo que demora esta sección: 0 minutos

1. Generamos matriz de sustituciones

Generamos mediante los algoritmos de Optimal Matching (OM) y Longest Common Subsequence (LCS). Se calcularon los costos de substitución entre secuencias de estados en un análisis de secuencias. El método utilizado es el TRATE, que calcula los costos en base a las tasas de transición observadas. Por fines computacionales, se asumirán que los costos no varían con el tiempo. Es decir, se asume que el costo de transición entre dos estados es constante a lo largo del período de estudio.

Código
costmatrix_quarter <- seqsubm(States_Wide.seq_quarter_t_prim_adm,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_quarter_rm <- seqsubm(States_Wide.seq_quarter_t_prim_adm_RM,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_quarter_cens <- seqsubm(States_Wide.seq_quarter_t_prim_adm_cens,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_month <- seqsubm(States_Wide.seq_month_t_prim_adm,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_month_rm <- seqsubm(States_Wide.seq_quarter_t_prim_adm_RM,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)
costmatrix_month_cens <- seqsubm(States_Wide.seq_month_t_prim_adm_cens,  # Sequence object
                      method = "TRATE",  # Method to determine costs
                      time.varying = FALSE) # Does not allow the cost to vary over time)

Tiempo que demora esta sección: 0 minutos

2. Análisis de cluster

Generamos distintas soluciones con distintas cantidades de conglomerados, desde 2 a 15, utilizando los algoritmos de distancia OM y LCS (1), además de replicarlo tanto para secuencias trimestrales y mensuales (2) y con y sin censura (3).

Primero calculamos una matriz de distancias utilizando el método de optimización de correspondencias (Optimal Matching, OM) y utilizando el método de la secuencia común más larga (Longest common subsequence, LCS). El primero tiene la ventaja de comparar secuencias de distinta duración, siendo bastante flexible, aunque puede implicar la distrorsión de los tiempos involucrados. Por otra parte, el segundo, al buscar la secuencia común más larga (independiente de estados intermedios), tiene la ventaja de no ser necesario definir costos de inserción o eliminación, no tener que ajustar muchos parámetros sujetos a decisiones arbitrarias, lo que hace más fácil de interpretar ya que se centra en las partes de secuencias que coinciden.Sin embargo, esta simplificación pierde diferencias o similitudes más específicas, y no permite ajustar esos costos de las diferencias.

Código
# ---- ** OPTIMAL MATCHING ----
dist_quarter_om <- seqdist(States_Wide.seq_quarter_t_prim_adm,
                   method = "OM",
                   indel= 1.0, #Ignored with non OM metrics.
                   sm = costmatrix_quarter)
dist_quarter_om_rm <- seqdist(States_Wide.seq_quarter_t_prim_adm_RM,
                   method = "OM",
                   indel= 1.0, #Ignored with non OM metrics.
                   sm = costmatrix_quarter_rm)
dist_quarter_om_cens <- seqdist(States_Wide.seq_quarter_t_prim_adm_cens,
                   method = "OM",
                   indel= 1.0,#Ignored with non OM metrics.
                   sm = costmatrix_quarter_cens)
dist_month_om <- seqdist(States_Wide.seq_month_t_prim_adm,
                   method = "OM",
                   indel= 1.0,#Ignored with non OM metrics.
                   sm = costmatrix_month)
dist_month_om_rm <- seqdist(States_Wide.seq_month_t_prim_adm_RM,
                   method = "OM",
                   indel= 1.0,#Ignored with non OM metrics.
                   sm = costmatrix_month_rm)
dist_month_om_cens <- seqdist(States_Wide.seq_month_t_prim_adm_cens,
                   method = "OM",
                   indel= 1.0,#Ignored with non OM metrics.
                   sm = costmatrix_month_cens)

# ---- ** LCS" (Longest Common Subsequence). ----
dist_quarter_lcs <- seqdist(States_Wide.seq_quarter_t_prim_adm,
                      method = "LCS", #"HAM",
                      sm = costmatrix_quarter)
dist_quarter_lcs_rm <- seqdist(States_Wide.seq_quarter_t_prim_adm_RM,
                      method = "LCS", #"HAM",
                      sm = costmatrix_quarter_rm)
dist_quarter_lcs_cens <- seqdist(States_Wide.seq_quarter_t_prim_adm_cens,
                      method = "LCS", #"HAM",
                      sm = costmatrix_quarter_cens)
dist_month_lcs <- seqdist(States_Wide.seq_month_t_prim_adm,
                      method = "LCS", #"HAM",
                      sm = costmatrix_month)
dist_month_lcs_rm <- seqdist(States_Wide.seq_month_t_prim_adm_RM,
                      method = "LCS", #"HAM",
                      sm = costmatrix_month_rm)
dist_month_lcs_cens <- seqdist(States_Wide.seq_month_t_prim_adm_cens,
                      method = "LCS", #"HAM",
                      sm = costmatrix_month_cens)

Tiempo que demora esta sección: 0 minutos

2.a. Clúster jerárquico

Se generó un análisis de clúster jerárquico mediante el método de agrupamiento (Ward.D2) minimiza la suma de las varianzas dentro de cada clúster.

\[ d(A, B) = \sqrt{ \frac{2|A||B|}{|A| + |B|} } \, \cdot ||c_A - c_B|| \] donde: - \(|A|\) y \(|B|\) son los tamaños de los conglomerados - \(x_i\) es un punto de datos en el conglomerado - \(c_A\) es el centroide del conglomerado A - \(c_B\) es el centroide del conglomerado B

Código
om_dist_quarter <- hclust(as.dist(dist_quarter_om), method = "ward.D2")
om_dist_quarter_rm <- hclust(as.dist(dist_quarter_om_rm), method = "ward.D2")

lcs_dist_quarter <- hclust(as.dist(dist_quarter_lcs), method = "ward.D2")
lcs_dist_quarter_rm <- hclust(as.dist(dist_quarter_lcs_rm), method = "ward.D2")

om_dist_quarter_cens <- hclust(as.dist(dist_quarter_om_cens), method = "ward.D2")
lcs_dist_quarter_cens <- hclust(as.dist(dist_quarter_lcs_cens), method = "ward.D2")

om_dist_month <- hclust(as.dist(dist_month_om), method = "ward.D2")
om_dist_month_rm <- hclust(as.dist(dist_month_om_rm), method = "ward.D2")

lcs_dist_month <- hclust(as.dist(dist_month_lcs), method = "ward.D2")
lcs_dist_month_rm <- hclust(as.dist(dist_month_lcs_rm), method = "ward.D2")

om_dist_month_cens <- hclust(as.dist(dist_month_om_cens), method = "ward.D2")
lcs_dist_month_cens <- hclust(as.dist(dist_month_lcs_cens), method = "ward.D2")

Tiempo que demora esta sección: 0.5 minutos

Se generan los dendogramas, que para mejor representación se restringe a un mínimo de de distancias (altura o dismilaridad) de 30. De manera que elementos que se encuentran separados por menos de 30 unidades en la matriz de dissimilaridad se considerará que pertenecen a una misma agrupación, lo que simplifica la visualización.

Trimestral

Código
plot(cut(as.dendrogram(om_dist_quarter), h = 30)$upper, 
     main = NULL, 
     ylab = "Distancia", xlab = "", cex = 0.5)
# recorded_plot <- recordPlot() 
# png("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/_figs/dendogram_hc_om_trimestral.png", height=6, width=8, res=200, units="in") 
# recorded_plot
# dev.off()
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(om_dist_quarter_rm), h = 30)$upper, 
     main = NULL, 
     ylab = "Distancia", xlab = "", cex = 0.5)
# recorded_plot <- recordPlot() 
# png("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/_figs/dendogram_hc_om_trimestral.png", height=6, width=8, res=200, units="in") 
# recorded_plot
# dev.off()
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(lcs_dist_quarter), h = 30)$upper, 
     main =NULL, 
     ylab = "Distancia", xlab = "", cex = 0.2)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(lcs_dist_quarter_rm), h = 30)$upper, 
     main =NULL, 
     ylab = "Distancia", xlab = "", cex = 0.2)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(om_dist_quarter_cens), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(lcs_dist_quarter_cens), h = 30)$upper, 
     main = NULL, 
     ylab = "Distancia", xlab = "", cex = 0.2)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0.6 minutos

  • Se puede observar que ambos algoritmos generan separaciones claras en 3 a 5 separaciones que serían más distinguibles.
  • En el caso de la región metropolitana, se puede distinguir 2 a 8 conglomerados, aunque 3 son más distinguibles y 5 son razonablemente distinguibles.

Mensual

Código
plot(cut(as.dendrogram(om_dist_month), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.5)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(om_dist_month_rm), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.5)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(lcs_dist_month), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(lcs_dist_month_rm), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(om_dist_month_cens), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

Código
plot(cut(as.dendrogram(lcs_dist_month_cens), h = 30)$upper, 
     main = NULL,
     ylab = "Distancia", xlab = "", cex = 0.2)
Dendogramas (cluster jerárquico)

Dendogramas (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

  • Se repite un patrón similar, aunque en este caso 2 a 3 agrupaciones son más claramente distinguibles en ambos. También se constatan solcuiones de 5, cuando no hay censura, y de 7, cuando se incorpora.
  • Para RM, se distinguen de 3 a 5, y también pueden vislumbrarse soluciones de 7 u 8 aunque más cercano a un salto en términos de separaciones.

2.a.1. Métricas de calidad

Se ven rangos de 2 a 15 conglomerados y se comparan sus métricas de calidad.

Código
om_dist_quarter_c <- as.clustrange(om_dist_quarter, diss=as.dist(dist_quarter_om), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_quarter_c, max.rank=14)
om_dist_quarter_c_rm <- as.clustrange(om_dist_quarter_rm, diss=as.dist(dist_quarter_om_rm), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_quarter_c_rm, max.rank=14)
om_dist_quarter_cens_c <- as.clustrange(om_dist_quarter_cens, diss=as.dist(dist_quarter_om_cens), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_quarter_cens_c, max.rank=14)
om_dist_month_c <- as.clustrange(om_dist_month, diss=as.dist(dist_month_om), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_quarter_c, max.rank=14)
om_dist_month_c_rm <- as.clustrange(om_dist_month_rm, diss=as.dist(dist_month_om_rm), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_month_c_rm, max.rank=14)
om_dist_month_cens_c <- as.clustrange(om_dist_month_cens, diss=as.dist(dist_month_om_cens), kvals=2:15, ncluster=15) # this takes some time to run
#summary(om_dist_month_cens_c, max.rank=14)

lcs_dist_quarter_c <- as.clustrange(lcs_dist_quarter, diss=as.dist(dist_quarter_lcs), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_quarter_c, max.rank=14)
lcs_dist_quarter_c_rm <- as.clustrange(lcs_dist_quarter_rm, diss=as.dist(dist_quarter_lcs_rm), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_quarter_c_rm, max.rank=14)
lcs_dist_quarter_cens_c <- as.clustrange(lcs_dist_quarter_cens, diss= as.dist(dist_quarter_lcs_cens), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_quarter_cens_c, max.rank=14)
lcs_dist_month_c <- as.clustrange(lcs_dist_month, diss=as.dist(dist_month_lcs), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_quarter_c, max.rank=14)
lcs_dist_month_c_rm <- as.clustrange(lcs_dist_month_rm, diss=as.dist(dist_month_lcs_rm), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_month_c_rm, max.rank=14)
lcs_dist_month_cens_c <- as.clustrange(lcs_dist_month_cens, diss=as.dist(dist_month_lcs_cens), kvals=2:15, ncluster=15) # this takes some time to run
#summary(lcs_dist_month_cens_c, max.rank=14)

Tiempo que demora esta sección: 0 minutos

El average silhouette width ASW (Anchura de la Silueta Promedio) mide la coherencia de los elementos dentro de los clústeres. Se calcula como la diferencia entre la distancia promedio de un punto a todos los puntos en su clúster y la distancia mínima promedio a todos los puntos en cualquier otro clúster. Los valores oscilan entre -1 y 1, donde un valor cercano a 1 indica que el punto está bien agrupado, un valor cercano a 0 indica que el punto está en el borde del clúster y un valor negativo indica que el punto puede estar mal agrupado.

El Hubert Gamma HG (estadística Gamma de Hubert) es un índice que mide la correlación entre la matriz de disimilitud original y la matriz de disimilitud generada a partir del dendrograma del clúster. Un valor alto de la estadística Gamma indica una buena correspondencia entre las dos matrices, lo que sugiere una estructura de clúster fuerte.

El C de Hubert HC (Estadística C de Hubert) es similar a la estadística Gamma de Hubert, pero se centra en la evaluación de la calidad de un solo clúster en lugar de la estructura de clúster completa. Mide la proporción de pares de puntos que están en el mismo clúster en la partición verdadera y en la partición obtenida por el algoritmo de agrupamiento. Un valor alto indica una buena correspondencia entre las particiones.

El point biserial correlation PBC (Correlación Biserial Puntual) es un índice que mide la correlación entre una variable continua y una variable binaria que indica la pertenencia a un clúster (0 o 1). En el contexto del análisis de clúster, se utiliza para evaluar la calidad de la separación entre clústeres. Un valor alto de PBC indica que los clústeres están bien separados, lo que sugiere una estructura de clúster fuerte.

Visualizamos los índices de calidad estandarizados, ya sea en magnitudes brutas o estandarizadas (std).

Código
par(mfrow =c(1,2)) 
plot(om_dist_quarter_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral")
abline(v=5, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_quarter_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std)")
abline(v=5, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
#pamRange_month_lcs$stats |> data.frame() |> dplyr::select("ASW","HC", "HG", "PBC") |> knitr::kable("markdown")
Índices de calidad (cluster jerárquico)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

  • De 5 a 9 cluster parece haber un ajuste y parsimonia adecuados. Particular atención requieren las soluciones de 5 a 6 cluster.
Código
par(mfrow =c(1,2)) 
plot(lcs_dist_quarter_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
abline(v=11, col="#666666", lty="longdash", lwd = 2)
plot(lcs_dist_quarter_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
abline(v=11, col="#666666", lty="longdash", lwd = 2)
Índices de calidad (cluster jerárquico)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

  • La solución de 2 conglomerados merece especial atención, junto con la de 9 conglomerados, para evitar simplificar. No obstante una solución de 11 conglomerados también obtiene métricas de calidad.
Código
par(mfrow =c(1,2)) 
plot(om_dist_quarter_cens_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
abline(v=11, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_quarter_cens_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std) (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=9, col="#666666", lty="longdash", lwd = 2)
abline(v=11, col="#666666", lty="longdash", lwd = 2)
Índices de calidad (cluster jerárquico)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

  • Especial atención merece la solcuión de 2 conglomerados, seguido por la solución de 11. Por otra parte, una solución de 8-9 conglomerados también muestra un balance aunque entre simplicidad y complejidad, aunque los conglomerados no sean del todo distinguibles.
Código
par(mfrow =c(1,2)) 
plot(lcs_dist_quarter_cens_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
plot(lcs_dist_quarter_cens_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std) (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
Índices de calidad (cluster jerárquico)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

La solución de 2 cluster es la de mejor calidad.

Código
par(mfrow =c(1,2)) 
plot(om_dist_quarter_c_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "OM Trimestral")
abline(v=4, col="#666666", lty="longdash", lwd = 2)
abline(v=5, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_quarter_c_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "OM Trimestral (std)")
abline(v=4, col="#666666", lty="longdash", lwd = 2)
abline(v=5, col="#666666", lty="longdash", lwd = 2)
Índices de calidad (cluster jerárquico)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

  • La solución de 4 o 5 conglomerados parece tener buenos índices de calidad y un balance entre calidad y complejidad.
Código
par(mfrow =c(1,2)) 
plot(lcs_dist_quarter_c_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)

plot(lcs_dist_quarter_c_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)
Índices de calidad (cluster jerárquico)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

  • La solución de 5 cluster parecen presentar un buen balance entre cohesión, correspondencia con los datos originales y separación, sumado a que es menos compleja que otras soluciones con mejor calidad.
Código
par(mfrow =c(1,2)) 
plot(om_dist_month_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", 
     lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=8, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_month_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=8, col="#666666", lty="longdash", lwd = 2)

Tiempo que demora esta sección: 0 minutos

  • La solución de 2 y 8 a 9 cluster merecen especial atención. La primera maximiza la separación, aunque las de 8 a 9 permiten hacer mayores distinciones más detalladas con una segmentación de separación razonable.
Código
par(mfrow =c(1,2)) 
plot(lcs_dist_month_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", 
     lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual")
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
plot(lcs_dist_month_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std)")
 abline(v=4, col="#666666", lty="longdash", lwd = 2)

Tiempo que demora esta sección: 0 minutos

  • La mejor solución parece ser el de 2 y 3 cluster. Sin embargo, es razonable considerar un modelo más complejo de 4 cluster con adecuadas métricas de calidad.
Código
par(mfrow =c(1,2)) 
plot(om_dist_month_cens_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lty=1, lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=3, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_month_cens_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lty=1, lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std) (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=3, col="#666666", lty="longdash", lwd = 2)

Tiempo que demora esta sección: 0 minutos

  • La mejor solución parece ser el de 2, seguido por el de 3 clusters, aunque el modelo de 7 ofrece una mayor complejidad pero tiene valores subóptimos en lo que refiere a las métricas de calidad.
Código
par(mfrow =c(1,2)) 
plot(lcs_dist_month_cens_c, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lty=1, lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (c/ censura)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=3, col="#666666", lty="longdash", lwd = 2)
plot(lcs_dist_month_cens_c, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lty=1, lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std) (c/ censura)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=3, col="#666666", lty="longdash", lwd = 2)

Tiempo que demora esta sección: 0 minutos

  • La solución de 2 clúster es la única que tiene niveles óptimos de ASW. Por otra parte, la solución de 3 clúster tiene ajustes razonables. Por último, las soluciones de 4 y 6 conglomerados presentan buenas métricas de calidad, aunque valores ASW bajos.
Código
par(mfrow =c(1,2)) 
plot(om_dist_month_c_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "OM Trimestral")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)
# abline(v=5, col="#666666", lty="longdash", lwd = 2)
plot(om_dist_month_c_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "OM Trimestral (std)")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)
# abline(v=5, col="#666666", lty="longdash", lwd = 2)
Índices de calidad (cluster jerárquico)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

  • Las soluciones de 5 y 6 conglomerados obtienen niveles de caldiad aceptables en términos de pertenencia de los miembros al conglomerados y otras métricas de calidad.
Código
par(mfrow =c(1,2)) 
plot(lcs_dist_month_c_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)

plot(lcs_dist_month_c_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
 abline(v=5, col="#666666", lty="longdash", lwd = 2)
Índices de calidad (cluster jerárquico)

Índices de calidad (cluster jerárquico)

Tiempo que demora esta sección: 0 minutos

  • Si bien los valores de ASW son menores al umbral, el modelo con mejor compromiso entre complejidad y calidad es la solución de 5 conglomerados.

2.b. Partitioning around medoids

Un modelo de generación de conglomerados más flexible que el aglomerativo jerárquico y el algoritmo de k-medias. Este método busca secuencias representativas en los datos, llamados medoides (medoids) y crean conglomerados mediante la asociación de cada secuencia a su medoide más cercano basado en la matriz de distancia. El fin es minimizar la suma de dissimilaridades de las observaciones a su secuenca representativa más cercana. Un medoid se define como la observación de un grupo que tiene la suma ponderada más pequeña de distancias de las otras observaciones en su grupo.

Código
##Look at cluster quality for a variety of cluster solutions
pamRange_quarter_om <- wcKMedRange(dist_quarter_om, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_om, max.rank=14)
pamRange_quarter_om_rm <- wcKMedRange(dist_quarter_om_rm, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_om_rm, max.rank=14)
pamRange_quarter_om_cens <- wcKMedRange(dist_quarter_om_cens, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_om_cens, max.rank=14)
pamRange_quarter_lcs <- wcKMedRange(dist_quarter_lcs, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_lcs, max.rank=14)
pamRange_quarter_lcs_rm <- wcKMedRange(dist_quarter_lcs_rm, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_lcs_rm, max.rank=14)
pamRange_quarter_lcs_cens <- wcKMedRange(dist_quarter_lcs_cens, kvals=2:15) # this takes a while to run
# summary(pamRange_quarter_lcs_cens, max.rank=14)

pamRange_month_om <- wcKMedRange(dist_month_om, kvals=2:15) # this takes a while to run
# summary(pamRange_month_om, max.rank=14)
pamRange_month_om_rm <- wcKMedRange(dist_month_om_rm, kvals=2:15) # this takes a while to run
# summary(pamRange_month_om_rm, max.rank=14)
pamRange_month_om_cens <- wcKMedRange(dist_month_om_cens, kvals=2:15) # this takes a while to run
# summary(pamRange_month_om_cens, max.rank=14)
pamRange_month_lcs <- wcKMedRange(dist_month_lcs, kvals=2:15) # this takes a while to run
# summary(pamRange_month_lcs, max.rank=14)
pamRange_month_lcs_rm <- wcKMedRange(dist_month_lcs_rm, kvals=2:15) # this takes a while to run
# summary(pamRange_month_lcs_rm, max.rank=14)
pamRange_month_lcs_cens <- wcKMedRange(dist_month_lcs_cens, kvals=2:15) # this takes a while to run
# summary(pamRange_month_lcs_cens, max.rank=14)

Tiempo que demora esta sección: 0.1 minutos

Visualizamos los índices de ajuste brutos y estandarizados (std).

Código
par(mfrow =c(1,2)) 
plot(pamRange_quarter_om, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "right", main = "OM Trimestral")
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
  abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_om, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std)")
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
  abline(v=6, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • La solución de 4 y 6 o 7 cluster parecen tener buenos índices de calidad. De todas formas, los índices ASW se encuentran en niveles que reflejan buena calidad, 6 - 7 cluster reflejan de mejor forma las distancias entre los puntos.
Código
par(mfrow =c(1,2)) 
plot(pamRange_quarter_lcs, stat = c("ASW","HC", "HG", "PBC"), xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral")
  abline(v=3, col="#666666", lty="longdash", lwd = 2)
  abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_lcs, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
  abline(v=3, col="#666666", lty="longdash", lwd = 2)
  abline(v=6, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • La solución de 3 a 6 cluster parecen mostrar mejores índices de calidad. De todas formas, las diferencias son pequeñas entre ellos, con especial atención a un número de 5 conglomerados.
Código
par(mfrow =c(1,2)) 
plot(pamRange_quarter_om_cens, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (c/ censura)")
 abline(v=7, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_om_cens, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std) (c/ censura)")
 abline(v=7, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • La solución de 7 cluster parece tener mejores índices comparativos, aunque valores subóptimos de ASW. No obstante, la solución de 2 cluster es simple y también tiene valores subóptimos.
Código
par(mfrow =c(1,2)) 
plot(pamRange_quarter_lcs_cens, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_lcs_cens, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std) (c/ censura)")
abline(v=2, col="#666666", lty="longdash", lwd = 2)
abline(v=6, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • La solución de 2 conglomerados presenta mejores índices de ajuste, aunque en general bastante bajos. Si se prioriza complejidad, una solución que asuma 6 conglomerados sería razonable, aunque todos con valores subóptimos en ASW.
Código
par(mfrow =c(1,2)) 
plot(pamRange_quarter_om_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "right", main = "OM Trimestral")
  abline(v=7, col="#666666", lty="longdash", lwd = 2)
 # abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_om_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Trimestral (std)")
  abline(v=7, col="#666666", lty="longdash", lwd = 2)
 # abline(v=6, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • La solución de 7 conglomerados presenta mejores ajustes a niveles relativos, aunque las diferencias son bastante pequeñas. La solución de 2 conglomerados presenta buenos niveles de calidad.
Código
par(mfrow =c(1,2)) 
plot(pamRange_quarter_lcs_rm, stat = c("ASW","HC", "HG", "PBC"), xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "bottomright", main = "LCS Trimestral")
  abline(v=5, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_quarter_lcs_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Trimestral (std)")
  abline(v=5, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • Una solución de 5 conglomerados parece ser parsmoniosa y tener mejores índices de calidad, ya que los conglomeardos logran separar mejor.
Código
par(mfrow =c(1,2)) 
plot(pamRange_month_om, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual")
# abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_om, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std)")
# abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=6, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • Las mejores soluciones son las de 6 conglomerados, aunque con valores subóptimos en ASW.
Código
par(mfrow =c(1,2)) 
plot(pamRange_month_lcs, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual")
# abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=6, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_lcs, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std)")
# abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=6, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • Las soluciones de 6 conglomerados parecen tener mejores índices de calidad, no obstante, se constatan valores subóptimos en ASW.
Código
par(mfrow =c(1,2)) 
plot(pamRange_month_om_cens, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (c/ censura)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=4, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_om_cens, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std) (c/ censura)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=4, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • Las soluciones de 2 y 4 cluster parecen ser las mejores en términos de calidad, aunque con valores subóptimos en ASW, por lo que podrían haber componentes que no calcen en los conglomerados.
Código
par(mfrow =c(1,2)) 
plot(pamRange_month_lcs_cens, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (c/ censura)")
  abline(v=2, col="#666666", lty="longdash", lwd = 2)
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_lcs_cens, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std) (c/ censura)")
  abline(v=2, col="#666666", lty="longdash", lwd = 2)
  abline(v=4, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • La solución de 2 clúster es la única que parece medianamente razonable en términos de calidad. Le sigue la de 4, aunque todas con bajos valores de calidad en general.
Código
par(mfrow =c(1,2)) 
plot(pamRange_month_om_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=4, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_om_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "OM Mensual (std)")
 abline(v=2, col="#666666", lty="longdash", lwd = 2)
 abline(v=4, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • La solución de 2 y 4 conglomerados consigue un ajuste relativamente mejor, siendo capaz de incorporar mayor complejidad aunque con valores levemente subóptimos en ASW.
Código
par(mfrow =c(1,2)) 
plot(pamRange_month_lcs_rm, stat = c("ASW","HC", "HG", "PBC"), ylab = "puntajes", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual")
abline(v=4, col="#666666", lty="longdash", lwd = 2)
abline(v=5, col="#666666", lty="longdash", lwd = 2)
plot(pamRange_month_lcs_rm, stat = c("ASW","HC", "HG", "PBC"), norm="zscore", ylab = "puntajes z", xlab= "N° de cluster", lwd = 2, cex=2, col = c('#729ea1', '#b08b52', '#d9ce98', '#a1b5d8'), legendpos = "topright", main = "LCS Mensual (std)")
 abline(v=4, col="#666666", lty="longdash", lwd = 2)
 abline(v=5, col="#666666", lty="longdash", lwd = 2)
Índices de ajuste (PAM)

Índices de ajuste (PAM)

Tiempo que demora esta sección: 0 minutos

  • La solución de 4 y 5 conglomerados parece ser la que mejores índices de calidad presentan, aunque subóptimos en ASW.


Información de la sesión

Código
cat(paste0("R library: ", Sys.getenv("R_LIBS_USER")))
cat(paste0("Date: ",withr::with_locale(new = c('LC_TIME' = 'C'), code =Sys.time())))
cat(paste0("Editor context: ", getwd()))
cat("quarto version: "); system("quarto --version") 

quarto::quarto_version()

save.image(paste0(folder_path,"20240903_25.RData"))
R library: C:\Users\andre\AppData\Local/R/win-library/4.4Date: 2025-03-22 19:16:38.722742Editor context: H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_IIquarto version: [1] 0
[1] '1.6.39'

Tiempo que demora esta sección: 0.3 minutos

Código
sesion_info <- devtools::session_info()

Warning in system2(“quarto”, “-V”, stdout = TRUE, env = paste0(“TMPDIR=”, : el comando ejecutado ‘“quarto” TMPDIR=C:/Users/andre/AppData/Local/Temp/RtmpeoRH2K/file716c179d7f22 -V’ tiene el estatus 1

Código
dplyr::select(
  tibble::as_tibble(sesion_info$packages),
  c(package, loadedversion, source)
) |> 
 knitr::kable(caption = "R packages", format = "html",
      col.names = c("Row number", "Package", "Version"),
    row.names = FALSE,
      align = c("c", "l", "r")) |> 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) |> 
  kableExtra::scroll_box(width = "100%", height = "375px")  
R packages
Row number Package Version
boot 1.3-31 CRAN (R 4.4.1)
cachem 1.1.0 CRAN (R 4.4.1)
cli 3.6.4 CRAN (R 4.4.1)
cluster 2.1.8.1 CRAN (R 4.4.1)
codetools 0.2-20 CRAN (R 4.4.1)
colorspace 2.1-1 CRAN (R 4.4.1)
data.table 1.17.0 CRAN (R 4.4.1)
devtools 2.4.5 CRAN (R 4.4.1)
digest 0.6.37 CRAN (R 4.4.0)
doFuture 1.0.1 CRAN (R 4.4.1)
doParallel 1.0.17 CRAN (R 4.4.1)
dplyr 1.1.4 CRAN (R 4.4.1)
ellipsis 0.3.2 CRAN (R 4.4.1)
evaluate 1.0.3 CRAN (R 4.4.1)
factoextra 1.0.7 CRAN (R 4.4.1)
farver 2.1.2 CRAN (R 4.4.1)
fastcluster 1.2.6 CRAN (R 4.4.1)
fastmap 1.2.0 CRAN (R 4.4.1)
forcats 1.0.0 CRAN (R 4.4.1)
foreach 1.5.2 CRAN (R 4.4.1)
fs 1.6.5 CRAN (R 4.4.2)
future 1.34.0 CRAN (R 4.4.1)
future.apply 1.11.3 CRAN (R 4.4.1)
generics 0.1.3 CRAN (R 4.4.1)
ggplot2 3.5.1 CRAN (R 4.4.1)
ggrepel 0.9.6 CRAN (R 4.4.1)
ggseqplot 0.8.5 CRAN (R 4.4.1)
globals 0.16.3 CRAN (R 4.4.1)
glue 1.8.0 CRAN (R 4.4.2)
gridExtra 2.3 CRAN (R 4.4.1)
gtable 0.3.6 CRAN (R 4.4.1)
haven 2.5.4 CRAN (R 4.4.1)
hms 1.1.3 CRAN (R 4.4.1)
htmltools 0.5.8.1 CRAN (R 4.4.1)
htmlwidgets 1.6.4 CRAN (R 4.4.1)
httpuv 1.6.15 CRAN (R 4.4.1)
iterators 1.0.14 CRAN (R 4.4.1)
jsonlite 1.9.1 CRAN (R 4.4.1)
kableExtra 1.4.0 CRAN (R 4.4.1)
knitr 1.49 CRAN (R 4.4.2)
labeling 0.4.3 CRAN (R 4.4.1)
later 1.4.1 CRAN (R 4.4.2)
lattice 0.22-6 CRAN (R 4.4.1)
lifecycle 1.0.4 CRAN (R 4.4.1)
listenv 0.9.1 CRAN (R 4.4.1)
lubridate 1.9.4 CRAN (R 4.4.1)
magrittr 2.0.3 CRAN (R 4.4.1)
MASS 7.3-60.2 CRAN (R 4.4.1)
Matrix 1.7-0 CRAN (R 4.4.1)
memoise 2.0.1 CRAN (R 4.4.1)
mgcv 1.9-1 CRAN (R 4.4.1)
mime 0.12 CRAN (R 4.4.1)
miniUI 0.1.1.1 CRAN (R 4.4.1)
munsell 0.5.1 CRAN (R 4.4.1)
NbClust 3.0.1 CRAN (R 4.4.1)
nlme 3.1-164 CRAN (R 4.4.1)
nnet 7.3-19 CRAN (R 4.4.1)
pacman 0.5.1 CRAN (R 4.4.1)
parallelly 1.42.0 CRAN (R 4.4.1)
patchwork 1.3.0 CRAN (R 4.4.1)
permute 0.9-7 CRAN (R 4.4.1)
pillar 1.10.1 CRAN (R 4.4.1)
pkgbuild 1.4.6 CRAN (R 4.4.1)
pkgconfig 2.0.3 CRAN (R 4.4.1)
pkgload 1.4.0 CRAN (R 4.4.2)
processx 3.8.6 CRAN (R 4.4.1)
profvis 0.4.0 CRAN (R 4.4.2)
progressr 0.15.1 CRAN (R 4.4.1)
promises 1.3.2 CRAN (R 4.4.2)
ps 1.9.0 CRAN (R 4.4.1)
purrr 1.0.4 CRAN (R 4.4.1)
quarto 1.4.4 CRAN (R 4.4.1)
R6 2.6.1 CRAN (R 4.4.1)
rbibutils 2.3 CRAN (R 4.4.1)
RColorBrewer 1.1-3 CRAN (R 4.4.1)
Rcpp 1.0.14 CRAN (R 4.4.1)
Rdpack 2.6.2 CRAN (R 4.4.1)
readr 2.1.5 CRAN (R 4.4.1)
remotes 2.5.0 CRAN (R 4.4.1)
rlang 1.1.5 CRAN (R 4.4.1)
rmarkdown 2.29 CRAN (R 4.4.2)
rstudioapi 0.17.1 CRAN (R 4.4.2)
scales 1.3.0 CRAN (R 4.4.1)
sessioninfo 1.2.3 CRAN (R 4.4.1)
shiny 1.10.0 CRAN (R 4.4.1)
stringi 1.8.4 CRAN (R 4.4.1)
stringr 1.5.1 CRAN (R 4.4.1)
survival 3.6-4 CRAN (R 4.4.1)
svglite 2.1.3 CRAN (R 4.4.1)
systemfonts 1.2.1 CRAN (R 4.4.1)
tibble 3.2.1 CRAN (R 4.4.1)
tidyr 1.3.1 CRAN (R 4.4.1)
tidyselect 1.2.1 CRAN (R 4.4.1)
tidyverse 2.0.0 CRAN (R 4.4.3)
timechange 0.3.0 CRAN (R 4.4.1)
Tmisc 1.0.1 CRAN (R 4.4.1)
TraMineR 2.2-11 CRAN (R 4.4.1)
TraMineRextras 0.6.8 CRAN (R 4.4.1)
tzdb 0.4.0 CRAN (R 4.4.1)
urlchecker 1.0.1 CRAN (R 4.4.1)
usethis 3.1.0 CRAN (R 4.4.2)
utf8 1.2.4 CRAN (R 4.4.1)
vctrs 0.6.5 CRAN (R 4.4.1)
vegan 2.6-10 CRAN (R 4.4.1)
vegclust 2.0.2 CRAN (R 4.4.1)
viridisLite 0.4.2 CRAN (R 4.4.1)
WeightedCluster 1.8-1 CRAN (R 4.4.1)
withr 3.0.2 CRAN (R 4.4.2)
xfun 0.51 CRAN (R 4.4.1)
xml2 1.3.7 CRAN (R 4.4.1)
xtable 1.8-4 CRAN (R 4.4.1)
yaml 2.3.10 CRAN (R 4.4.1)

Tiempo que demora esta sección: 0.1 minutos

Código
reticulate::py_list_packages()%>% 
 knitr::kable(caption = "Python packages", format = "html",
      col.names = c("Package", "Version", "Requirement"),
    row.names = FALSE,
      align = c("c", "l", "r", "r"))%>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12)|>
  kableExtra::scroll_box(width = "100%", height = "375px")  
Python packages
Package Version Requirement
absl-py 2.1.0 absl-py==2.1.0
asttokens 2.4.1 asttokens==2.4.1
astunparse 1.6.3 astunparse==1.6.3
audioconverter 2.0.3 audioconverter==2.0.3
autograd 1.6.2 autograd==1.6.2
autograd-gamma 0.5.0 autograd-gamma==0.5.0
beautifulsoup4 4.12.3 beautifulsoup4==4.12.3
Brotli 1.1.0 Brotli==1.1.0
certifi 2023.11.17 certifi==2023.11.17
cffi 1.16.0 cffi==1.16.0
charset-normalizer 3.3.2 charset-normalizer==3.3.2
clarabel 0.9.0 clarabel==0.9.0
click 8.1.7 click==8.1.7
cloudpickle 3.0.0 cloudpickle==3.0.0
colorama 0.4.6 colorama==0.4.6
comm 0.2.1 comm==0.2.1
contourpy 1.2.0 contourpy==1.2.0
cvxopt 1.3.2 cvxopt==1.3.2
cvxpy 1.5.2 cvxpy==1.5.2
cycler 0.12.1 cycler==0.12.1
debugpy 1.8.0 debugpy==1.8.0
decorator 4.4.2 decorator==4.4.2
delete-chrome-history-py 0.1.8 delete-chrome-history-py==0.1.8
easyocr 1.7.1 easyocr==1.7.1
ecos 2.0.13 ecos==2.0.13
editdistance 0.8.1 editdistance==0.8.1
efficientnet 1.0.0 efficientnet==1.0.0
essential-generators 1.0 essential-generators==1.0
et-xmlfile 1.1.0 et-xmlfile==1.1.0
executing 2.0.1 executing==2.0.1
fancyimpute 0.7.0 fancyimpute==0.7.0
ffmpeg 1.4 ffmpeg==1.4
ffmpeg-python 0.2.0 ffmpeg-python==0.2.0
filedir 0.0.3 filedir==0.0.3
filelock 3.13.1 filelock==3.13.1
flatbuffers 24.3.25 flatbuffers==24.3.25
fonttools 4.47.2 fonttools==4.47.2
formulaic 1.0.1 formulaic==1.0.1
fsspec 2023.12.2 fsspec==2023.12.2
future 0.18.3 future==0.18.3
gast 0.6.0 gast==0.6.0
git-filter-repo 2.45.0 git-filter-repo==2.45.0
google-pasta 0.2.0 google-pasta==0.2.0
graphviz 0.20.3 graphviz==0.20.3
grpcio 1.65.4 grpcio==1.65.4
gTTS 2.5.1 gTTS==2.5.1
h5py 3.11.0 h5py==3.11.0
idna 3.6 idna==3.6
imageio 2.34.2 imageio==2.34.2
imageio-ffmpeg 0.5.1 imageio-ffmpeg==0.5.1
imgaug 0.4.0 imgaug==0.4.0
iniconfig 2.0.0 iniconfig==2.0.0
interface-meta 1.3.0 interface-meta==1.3.0
ipykernel 6.29.5 ipykernel==6.29.5
ipython 8.20.0 ipython==8.20.0
jedi 0.19.1 jedi==0.19.1
Jinja2 3.1.3 Jinja2==3.1.3
joblib 1.4.0 joblib==1.4.0
jupyter_client 8.6.0 jupyter_client==8.6.0
jupyter_core 5.7.1 jupyter_core==5.7.1
keras 3.4.1 keras==3.4.1
Keras-Applications 1.0.8 Keras-Applications==1.0.8
keras-ocr 0.9.3 keras-ocr==0.9.3
kiwisolver 1.4.5 kiwisolver==1.4.5
knnimpute 0.1.0 knnimpute==0.1.0
lazy_loader 0.4 lazy_loader==0.4
libclang 18.1.1 libclang==18.1.1
lifelines 0.28.0 lifelines==0.28.0
llvmlite 0.41.1 llvmlite==0.41.1
Markdown 3.6 Markdown==3.6
markdown-it-py 3.0.0 markdown-it-py==3.0.0
MarkupSafe 2.1.4 MarkupSafe==2.1.4
matplotlib 3.8.2 matplotlib==3.8.2
matplotlib-inline 0.1.6 matplotlib-inline==0.1.6
mdurl 0.1.2 mdurl==0.1.2
mido 1.3.3 mido==1.3.3
ml-dtypes 0.4.0 ml-dtypes==0.4.0
more-itertools 10.2.0 more-itertools==10.2.0
moviepy 1.0.3 moviepy==1.0.3
mpmath 1.3.0 mpmath==1.3.0
multipledispatch 1.0.0 multipledispatch==1.0.0
mutagen 1.47.0 mutagen==1.47.0
namex 0.0.8 namex==0.0.8
natsort 8.4.0 natsort==8.4.0
nest-asyncio 1.5.9 nest-asyncio==1.5.9
networkx 3.2.1 networkx==3.2.1
ninja 1.11.1.1 ninja==1.11.1.1
nose 1.3.7 nose==1.3.7
numba 0.58.1 numba==0.58.1
numexpr 2.10.0 numexpr==2.10.0
numpy 1.26.3 numpy==1.26.3
openai-whisper 20231117 openai-whisper==20231117
opencv-python 4.10.0.84 opencv-python==4.10.0.84
opencv-python-headless 4.10.0.84 opencv-python-headless==4.10.0.84
openpyxl 3.1.4 openpyxl==3.1.4
opt-einsum 3.3.0 opt-einsum==3.3.0
optree 0.12.1 optree==0.12.1
osqp 0.6.5 osqp==0.6.5
packaging 23.2 packaging==23.2
pandas 2.2.0 pandas==2.2.0
pandas-flavor 0.6.0 pandas-flavor==0.6.0
parso 0.8.3 parso==0.8.3
patsy 0.5.6 patsy==0.5.6
pillow 10.2.0 pillow==10.2.0
platformdirs 4.1.0 platformdirs==4.1.0
pluggy 1.5.0 pluggy==1.5.0
polars 1.9.0 polars==1.9.0
proglog 0.1.10 proglog==0.1.10
prompt-toolkit 3.0.43 prompt-toolkit==3.0.43
protobuf 4.25.4 protobuf==4.25.4
psutil 5.9.8 psutil==5.9.8
pure-eval 0.2.2 pure-eval==0.2.2
pyarrow 15.0.0 pyarrow==15.0.0
pyclipper 1.3.0.post5 pyclipper==1.3.0.post5
pycparser 2.22 pycparser==2.22
pycryptodomex 3.20.0 pycryptodomex==3.20.0
pydotplus 2.0.2 pydotplus==2.0.2
pydub 0.24.1 pydub==0.24.1
Pygments 2.17.2 Pygments==2.17.2
pyjanitor 0.26.0 pyjanitor==0.26.0
PyMuPDF 1.24.9 PyMuPDF==1.24.9
PyMuPDFb 1.24.9 PyMuPDFb==1.24.9
pyparsing 3.1.1 pyparsing==3.1.1
PyPDF2 3.0.1 PyPDF2==3.0.1
pyreadr 0.5.0 pyreadr==0.5.0
pytesseract 0.3.10 pytesseract==0.3.10
pytest 8.3.1 pytest==8.3.1
python-bidi 0.6.0 python-bidi==0.6.0
python-dateutil 2.8.2 python-dateutil==2.8.2
pytube 15.0.0 pytube==15.0.0
pytube3 9.6.4 pytube3==9.6.4
pytz 2023.3.post1 pytz==2023.3.post1
pywin32 306 pywin32==306
PyYAML 6.0.1 PyYAML==6.0.1
pyzmq 25.1.2 pyzmq==25.1.2
qdldl 0.1.7.post1 qdldl==0.1.7.post1
regex 2023.12.25 regex==2023.12.25
requests 2.32.3 requests==2.32.3
rich 13.7.1 rich==13.7.1
rpy2 3.5.16 rpy2==3.5.16
scikit-image 0.24.0 scikit-image==0.24.0
scikit-learn 1.3.2 scikit-learn==1.3.2
scikit-survival 0.22.2 scikit-survival==0.22.2
scipy 1.11.4 scipy==1.11.4
scs 3.2.6 scs==3.2.6
seaborn 0.13.2 seaborn==0.13.2
semantic-version 2.10.0 semantic-version==2.10.0
setuptools-rust 1.8.1 setuptools-rust==1.8.1
shapely 2.0.5 shapely==2.0.5
six 1.16.0 six==1.16.0
soupsieve 2.5 soupsieve==2.5
SpeechRecognition 3.10.1 SpeechRecognition==3.10.1
spyder-kernels 2.5.2 spyder-kernels==2.5.2
stack-data 0.6.3 stack-data==0.6.3
statsmodels 0.14.1 statsmodels==0.14.1
sympy 1.12 sympy==1.12
target 0.0.11 target==0.0.11
tensorboard 2.17.0 tensorboard==2.17.0
tensorboard-data-server 0.7.2 tensorboard-data-server==0.7.2
tensorflow 2.17.0 tensorflow==2.17.0
tensorflow-intel 2.17.0 tensorflow-intel==2.17.0
tensorflow-io-gcs-filesystem 0.31.0 tensorflow-io-gcs-filesystem==0.31.0
termcolor 2.4.0 termcolor==2.4.0
threadpoolctl 3.4.0 threadpoolctl==3.4.0
tifffile 2024.7.24 tifffile==2024.7.24
tiktoken 0.5.2 tiktoken==0.5.2
torch 2.4.0 torch==2.4.0
torchaudio 2.4.0 torchaudio==2.4.0
torchvision 0.19.0 torchvision==0.19.0
tornado 6.4 tornado==6.4
tqdm 4.66.1 tqdm==4.66.1
traitlets 5.14.1 traitlets==5.14.1
translator 0.0.9 translator==0.0.9
typing_extensions 4.9.0 typing_extensions==4.9.0
tzdata 2023.4 tzdata==2023.4
tzlocal 5.2 tzlocal==5.2
urllib3 2.1.0 urllib3==2.1.0
validators 0.33.0 validators==0.33.0
watchdog 3.0.0 watchdog==3.0.0
wcwidth 0.2.13 wcwidth==0.2.13
websockets 12.0 websockets==12.0
Werkzeug 3.0.3 Werkzeug==3.0.3
whisper 1.1.10 whisper==1.1.10
wrapt 1.16.0 wrapt==1.16.0
xarray 2024.1.1 xarray==2024.1.1
youtube-dl 2021.12.17 youtube-dl==2021.12.17
yt-dlp 2024.7.9 yt-dlp==2024.7.9

Tiempo que demora esta sección: 0.1 minutos